home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 003 / dbsteel1.arc / ASCII.BAS next >
BASIC Source File  |  1983-03-10  |  10KB  |  375 lines
  1. 3 DEFDBL X         
  2. 4 DEFINT A-W,Y-Z
  3. 5 DIM F$(15),FLDN$(15,30),FTY(15,30),FL(15,30)
  4. 10 DIM X$(30)
  5. 13 DIM L(15),NREC(15)
  6. 14 DIM X(20)
  7. 20 DIM XL(40)
  8. 35 DIM K$(80)
  9. 61 CH = 29: PRINT FRE(0)      
  10. 70 NE = 0
  11. 75 GOSUB 50000
  12. 80 GOSUB 10000
  13. 400 GOSUB 13000
  14. 404 GOSUB 13000
  15. 410 PRINT "**********  ASCII PROGRAM  --  WHAT FILE DO YOU WANT:  **********"
  16. 420 PRINT ""
  17. 425 PRINT " 0  - *** EXIT THE PROGRAM ***"
  18. 430 FOR I = 1 TO MAXF
  19. 440 PRINT I;" - ";F$(I)
  20. 450 NEXT I
  21. 460 PRINT ""
  22. 470 PRINT "***** ENTER THE NUMBER OF THE FILE YOU WANT THEN PRESS RETURN *****"
  23. 475 GOSUB 14000
  24. 477 IF DT# < 0 OR DT#>MAXF  GOTO 475
  25. 480 A = DT#
  26. 482 IF A = 0 GOTO 51000
  27. 483 GOSUB 13000
  28. 484 PRINT "FILE : "; F$(A)
  29. 485 GOSUB 2300
  30. 490 GOSUB 2500
  31. 495 GOSUB 8000
  32. 500 GOTO 6000
  33. 2300 REM **************  DISK  SELECTION  ***************
  34. 2302 IF HDISK = 2 THEN GOSUB 13000
  35. 2303 IF HDISK = 2 THEN GOTO 2360
  36. 2304 PRINT ""
  37. 2305 PRINT "************  WHICH DISK DRIVE IS THE FILE ON  **************"
  38. 2310 PRINT ""
  39. 2315 PRINT "                 1 - DISK DRIVE A"
  40. 2320 PRINT "                 2 - DISK DRIVE B"
  41. 2325 PRINT "                 3 - DISK DRIVE C"
  42. 2330 PRINT "                 4 - DISK DRIVE D"
  43. 2335 PRINT ""
  44. 2340 PRINT "***********  ENTER THE NUMBER THEN PRESS RETURN  ************"
  45. 2345 GOSUB 14000
  46. 2347 IF DT# < 0 OR DT#>4 GOTO 2345
  47. 2350 T = DT#
  48. 2355 ON T GOTO 2360,2370,2380,2390
  49. 2360 T$ = F$(A)
  50. 2365 GOTO 2490
  51. 2370 T$ = "B:"+F$(A)
  52. 2375 GOTO 2490
  53. 2380 T$ = "C:"+F$(A)
  54. 2385 GOTO 2490
  55. 2390 T$ = "D:"+F$(A)
  56. 2490 RETURN
  57. 2500 REM *******  OPEN FILE SUBROUTINE  *******
  58. 2503 CLOSE #1
  59. 2505 OPEN "R",#1,T$,L(A)
  60. 2507 D = 0
  61. 2510 FOR T = 1 TO NREC(A)
  62. 2520 FIELD #1,D AS DY$,FL(A,T) AS X$(T)
  63. 2530 D = D + FL(A,T)
  64. 2540 NEXT T
  65. 2543 GOSUB 7800
  66. 2545 RETURN
  67. 6000 REM *****  CHANGE TO SEQUENTIAL ASCII FILE
  68. 6075 GOSUB 13000
  69. 6100 PRINT "    This program converts the records you specify to "
  70. 6110 PRINT "               to a sequential ASCII form"
  71. 6120 PRINT ""
  72. 6278 PRINT "********  WHAT RECORD DO YOU WANT TO START AT  *********"
  73. 6281 PRINT ""
  74. 6282 PRINT "             Enter Zero When you are done "
  75. 6283 PRINT ""
  76. 6284 PRINT "********  ENTER THE NUMBER THEN PRESS RETURN  *********"
  77. 6287 GOSUB 14100
  78. 6288 IF DT# <0 OR DT# > MRN GOTO 6287
  79. 6290 RNS= DT#
  80. 6300 IF RNS = 0 THEN 51000
  81. 6375 PRINT ""
  82. 6378 PRINT "*********  WHAT RECORD DO YOU WANT TO END AT  *********"
  83. 6381 PRINT ""
  84. 6384 PRINT "********  ENTER THE NUMBER THEN PRESS RETURN  *********"
  85. 6387 GOSUB 14100
  86. 6388 IF DT# <1 OR DT# > MRN  GOTO 6387
  87. 6390 RNF= DT#
  88. 6396 REM GET RECORD
  89. 6399 FOR T = RNS TO RNF 
  90. 6402 GET #1,T
  91. 6403 GOSUB 6417
  92. 6404 PRINT #2,""
  93. 6405 NEXT T 
  94. 6406 GOSUB 13000
  95. 6407 PRINT "*** ANY MORE RECORDS TO CONVERT ***"
  96. 6410 GOTO 6100
  97. 6417 FOR Q = 1 TO NREC(A)
  98. 6435 ON FTY(A,Q) GOSUB 6507,6441,6453,6465,6465
  99. 6436 IF Q < NREC(A) THEN PRINT #2,CHR$(44);
  100. 6438 NEXT Q
  101. 6439 RETURN
  102. 6440 REM ************** CONVERT STRINGS TO DECIMALS ****************
  103. 6441 I%=CVI(X$(Q))
  104. 6447 PRINT #2,I%;
  105. 6450 RETURN
  106. 6453 I!=CVS(X$(Q))
  107. 6459 PRINT #2,I!;
  108. 6462 RETURN
  109. 6465 I#=CVD(X$(Q))
  110. 6468 PRINT #2,I#;
  111. 6471 RETURN
  112. 6507 I$ = X$(Q)
  113. 6508 PRINT #2,CHR$(34);I$;CHR$(34);
  114. 6510 RETURN
  115. 7800 MRN = LOF(1)/ L(A)
  116. 7805 REM MRN = INT(MRN)
  117. 7810 RETURN
  118. 7900 REM ***** LOF
  119. 7910 MRN2 = LOF(3)/82
  120. 7920 RETURN
  121. 7950 REM ******* LOF
  122. 7960 MRNS = LOF(B)/L(B)
  123. 7970 RETURN
  124. 8000 REM ****** OPEN ASCII FILE
  125. 8100 OPEN "O",#2,"ASCIDATA"
  126. 8200 RETURN
  127. 9070 ON FTY(A,N) GOTO 9100,9150,9200,9250,9250
  128. 9100 REM
  129. 9110 LSET X$(N) = I$
  130. 9120 GOTO 9290
  131. 9150 REM
  132. 9160 LSET X$(N) = MKI$(I#)
  133. 9170 GOTO 9290
  134. 9200 REM
  135. 9210 LSET X$(N) = MKS$(I#)
  136. 9220 GOTO 9290
  137. 9250 REM  
  138. 9260 LSET X$(N) = MKD$(I#)
  139. 9290 RETURN
  140. 10000 REM *************  READ SUBROUTINE  *************
  141. 10004 GOSUB 10900
  142. 10010 OPEN "I",#1,"FFILE"
  143. 10020 INPUT #1,MAXF
  144. 10030 FOR A = 1 TO MAXF
  145. 10040 INPUT #1,A,F$(A),NREC(A),L(A)
  146. 10050 FOR N = 1 TO NREC(A)
  147. 10060 INPUT #1,FLDN$(A,N),FTY(A,N),FL(A,N)
  148. 10070 IF FTY(A,N) = 2 THEN INPUT #1,D,D
  149. 10080 NEXT N
  150. 10090 NEXT A
  151. 10100 CLOSE #1
  152. 10110 RETURN
  153. 10900 REM  *************  PUT DISK IN DRIVE SUB
  154. 10905 IF HDISK = 2 THEN RETURN
  155. 10910 GOSUB 13000
  156. 10920 PRINT "    ********  PUT PROGRAM DATA DISK IN THE DEFAULT DISK DRIVE  *********"
  157. 10930 PRINT ""
  158. 10940 PRINT "                     THEN PRESS ANY KEY TO CONTINUE "
  159. 10950 PRINT ""
  160. 10960 PRINT "    If the program data disk is already in the default disk drive then"
  161. 10965 PRINT "                   just press any key to continue."
  162. 10970 PRINT ""
  163. 10990 IF INKEY$ = "" GOTO 10990
  164. 10995 RETURN
  165. 13000 REM *********  CLEAR SCREEN
  166. 13010 CLS
  167. 13020 RETURN
  168. 13100 REM *********  LOCATE  
  169. 13110 LOCATE LI,1
  170. 13120 RETURN
  171. 13200 FOR T% = 1 TO 80
  172. 13210 PRINT CHR$(8);
  173. 13220 NEXT T%
  174. 13222 FOR T% = 1 TO 24
  175. 13223 PRINT CHR$(11);
  176. 13224 NEXT T%
  177. 13225 LI = LI - 1
  178. 13230 FOR T% = 1 TO LI
  179. 13240 PRINT CHR$(0)
  180. 13250 NEXT T%
  181. 13590 RETURN
  182. 13600 REM ****** CHECK FOR ASC0
  183. 13610 S4$ = INKEY$
  184. 13620 C2 =  ASC(S4$)
  185. 13630 IF C2 = 83 THEN C = 1
  186. 13640 IF C2 = 82 THEN C = 6
  187. 13650 IF C2 = 75 THEN C = 19
  188. 13660 IF C2 = 77 THEN C = 4 
  189. 13670 RETURN
  190. 14000 REM *******  INTEGER LESS THEN 100 CHECK  ********
  191. 14010 MAX = 2
  192. 14020 ACT$ = "1234567890=<>^"
  193. 14023 IF NE = 0 THEN ACT$ = "1234567890"
  194. 14025 PRINT ">__<";
  195. 14030 GOTO 14500
  196. 14100 REM *******  INTEGER *******                        
  197. 14110 MAX = 8
  198. 14120 ACT$ = "1234567890-+,=<>^"
  199. 14123 IF NE = 0 THEN ACT$ = "1234567890-+,"
  200. 14125 PRINT ">________<";
  201. 14130 GOTO 14500
  202. 14200 REM *******  SINGLE PRECISION  *******                        
  203. 14210 MAX = 10
  204. 14220 ACT$ = "1234567890-+,.%$=<>^"
  205. 14223 IF NE = 0 THEN ACT$ = "1234567890+-,.%$"
  206. 14225 PRINT ">__________<";
  207. 14230 GOTO 14500
  208. 14300 REM *******  DOUBLE PRECISION  *******                        
  209. 14310 MAX = 20
  210. 14320 ACT$ = "1234567890-+,.%$=<>^"
  211. 14323 IF NE = 0 THEN ACT$ = "1234567890+-,.%$"
  212. 14325 PRINT ">____________________<";
  213. 14330 GOTO 14500
  214. 14500 REM ********** NUMBER CHECK **********
  215. 14505 A$ = ""
  216. 14510 K$(20) = " "
  217. 14515 KTMAX = 0
  218. 14520 FOR T9 = 1 TO MAX
  219. 14525 K$(T9) = " "
  220. 14530 NEXT T9
  221. 14535 DIG$ = "1234567890."
  222. 14540 DOTFLG = 0
  223. 14541 T2 = MAX + 1
  224. 14542 FOR T6 = 1 TO T2
  225. 14544 PRINT CHR$(CH);
  226. 14546 NEXT T6
  227. 14550 IF INKEY$ = "" GOTO 14560 ELSE GOTO 14550
  228. 14560 KT = 0
  229. 14565 REM ***********  CHECK ALFANUMERIC INPUT FOR LENGTH  ***********
  230. 14570 KT = KT + 1
  231. 14575 REM     
  232. 14580 W$ = INKEY$
  233. 14585 IF W$ = "" GOTO 14580
  234. 14590 C = ASC(W$)
  235. 14593 IF C = 0 THEN GOSUB 13600
  236. 14595 IF C = 13 GOTO 14660
  237. 14600 IF C = 17 OR C = 8 GOTO 14860
  238. 14605 IF C = 19 GOTO 14690
  239. 14610 IF C = 4 GOTO 14710
  240. 14615 IF C = 6 GOTO 14730
  241. 14620 IF C = 1 GOTO 14790
  242. 14625 IF KT > MAX GOTO 14575
  243. 14630 IF INSTR(ACT$,W$) = 0 GOTO 14890
  244. 14635 K$(KT) = W$
  245. 14645 PRINT K$(KT);
  246. 14650 IF KT > KTMAX THEN KTMAX = KT
  247. 14655 GOTO 14570
  248. 14660 REM **********  RETURN  **********
  249. 14670 FOR T9 = 1 TO KTMAX
  250. 14675 A$ = A$ + K$(T9)
  251. 14680 NEXT T9
  252. 14681 IF KTMAX = 0 THEN PRINT "1"
  253. 14682 IF KTMAX = 0 THEN DT# = 1
  254. 14683 IF KTMAX = 0 THEN RETURN
  255. 14684 PRINT ""
  256. 14685 GOTO 14905
  257. 14690 REM ********* MOVE CURSE BACK ********
  258. 14695 IF KT = 1 GOTO 14575
  259. 14700 KT = KT - 1
  260. 14703 PRINT CHR$(CH);
  261. 14705 GOTO 14575
  262. 14710 REM ********* MOVE CURSER FORWARD *********
  263. 14715 IF KT >= MAX GOTO 14575
  264. 14716 IF KT > (KTMAX + 1) GOTO 14575
  265. 14718 PRINT K$(KT);
  266. 14720 KT = KT + 1
  267. 14725 GOTO 14575
  268. 14730 REM ********** INSERT ***********
  269. 14733 IF KT > KTMAX GOTO 14575
  270. 14735 X9 = MAX
  271. 14740 WHILE X9 > KT
  272. 14745 X9 = X9 - 1
  273. 14750 K$(X9 + 1) = K$(X9)
  274. 14755 WEND 
  275. 14760 K$(KT) = " "
  276. 14767 KTMAX = KTMAX + 1
  277. 14769 IF KTMAX > MAX THEN KTMAX = MAX
  278. 14770 FOR T9 = KT TO KTMAX
  279. 14775 PRINT K$(T9);
  280. 14780 NEXT T9
  281. 14781 T6 = (KTMAX - KT) + 1
  282. 14782 FOR T7 = 1 TO T6
  283. 14783 PRINT CHR$(CH);
  284. 14784 NEXT T7
  285. 14785 GOTO 14575
  286. 14790 REM ********** DELETE ***********
  287. 14793 IF KT > KTMAX GOTO 14575
  288. 14794 IF KTMAX = 1 GOTO 14575
  289. 14795 K$(MAX + 1) = ""
  290. 14800 X9 = KT 
  291. 14805 WHILE X9 <= MAX
  292. 14810 K$(X9) = K$(X9 + 1)
  293. 14815 X9 = X9 + 1
  294. 14820 WEND 
  295. 14830 KTMAX = KTMAX - 1
  296. 14835 FOR T9 = KT TO KTMAX
  297. 14840 PRINT K$(T9);
  298. 14845 NEXT T9
  299. 14850 PRINT "_";
  300. 14851 T7 = (KTMAX - KT) + 2
  301. 14852 FOR T8 = 1 TO T7
  302. 14853 PRINT CHR$(CH);
  303. 14854 NEXT T8
  304. 14855 GOTO 14575
  305. 14860 REM ********* BACKSPACE ********
  306. 14865 IF KT = 1 GOTO 14575
  307. 14870 KT = KT - 1
  308. 14875 PRINT CHR$(CH);
  309. 14877 K$(KT) = " " 
  310. 14880 PRINT "_";
  311. 14883 PRINT CHR$(CH);
  312. 14885 GOTO 14575
  313. 14890 REM *******  INPUT NOT ACCEPTABLE  ********
  314. 14895 PRINT CHR$(7);
  315. 14900 GOTO 14580
  316. 14905 REM ********* CLEAR STRINGS ********
  317. 14910 MAX = LEN(A$)
  318. 14915 D2$ = ""
  319. 14920 D1$ = ""
  320. 14925 DFLG = 0
  321. 14930 FOR Q93 = 1 TO MAX
  322. 14935 R$ = MID$(A$,Q93,1)
  323. 14940 IF INSTR(DIG$,R$) = 0 GOTO 14975
  324. 14945 IF R$ = "." OR DFLG = 1 GOTO 14965
  325. 14950 IF DFLG = 1 GOTO 14965
  326. 14955 D2$ = D2$ + R$
  327. 14960 GOTO 14975
  328. 14965 D1$ = D1$ + R$
  329. 14970 DFLG = 1
  330. 14975 NEXT Q93
  331. 14980 DA# = VAL(D2$)
  332. 14985 D1# = VAL(D1$)
  333. 14990 DT# = DA# + D1#
  334. 14995 IF K$(1) = "-" THEN DT# =  -DT#   
  335. 14997 RETURN
  336. 26000 REM ******* ON ERROR ROUTINE ************
  337. 26100 EFLG = 1
  338. 26200 PRINT "**********  END OF FILE  ***********"
  339. 26202 PRINT "**** PRESS ANY KEY TO CONTINUE ****"
  340. 26204 IF INKEY$ = "" GOTO 26204
  341. 26500 REM *********  ON ERROR SUBROUTINE ***********
  342. 26600 PRINT "**********  END OF FILE  ***********"
  343. 26610 PRINT "**** PRESS ANY KEY TO CONTINUE ****"
  344. 26620 IF INKEY$ = "" GOTO 26620
  345. 26635 EFLG = 1
  346. 26640 RETURN        
  347. 26800 REM **********  ON ERROR GOTO  **************
  348. 26900 PRINT "************  RECORD NOT FOUND  *************"
  349. 41000 REM ***** WRITE SECOND FILE
  350. 41100 LSET Y$ = XT$
  351. 41200 PUT #2,RN2
  352. 41300 RN2 = RN2 + 1
  353. 41400 RETURN
  354. 50000 REM **********  INTRO
  355. 50010 GOSUB 13000
  356. 50100 PRINT "                A S C I I    P R O G R A M    3.0   "
  357. 50105 PRINT ""
  358. 50110 PRINT "        Copyright 1984 by Potomac Pacific Engineering Inc."
  359. 50120 PRINT ""
  360. 50130 PRINT "This program is licensed FREE to all users with some restrictions"
  361. 50165 PRINT "        See the manual for more information on the license."
  362. 50167 PRINT ""
  363. 50950 PRINT "******************  PRESS ANY KEY TO CONTINUE  ******************";
  364. 50960 IF INKEY$ = "" GOTO 50960
  365. 50970 RETURN
  366. 51000 REM *******  DONE
  367. 51100 CLOSE
  368. 51105 GOSUB 13000
  369. 51110 PRINT " -BYE, Have a nice day
  370. 51120 END
  371.  50960
  372. 50970 RETURN
  373. 51000 REM *******  DONE
  374. 51100 CLOSE
  375. 51